home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok44.lha / Scan / Scan.mod < prev    next >
Text File  |  1993-08-15  |  5KB  |  184 lines
  1. (**********************************************************************
  2.  
  3.     :Program.    Scan.mod
  4.     :Contents.   Scans for a file
  5.     :Author.     Gerhard 'Fido' Schneider
  6.     :Address.    Schadewitzstraße 22, D-8700 Würzburg
  7.     :Copyright.  Buplik Tomain
  8.     :Language.   Modula-2
  9.     :Translator. M2Amiga A+L V3.2d
  10.     :Imports.    Arp
  11.     :History.    Unknown
  12.  
  13. **********************************************************************)
  14. MODULE Scan;
  15.  
  16. FROM Dos       IMPORT FileLockPtr,accessRead,FileInfoBlockPtr,FileInfoBlock,
  17.                       ctrlC,ctrlF;
  18. FROM SYSTEM    IMPORT ADR,ADDRESS,CAST,LONGSET;
  19. FROM Str       IMPORT Concat,Length,Compare;
  20. FROM Arp       IMPORT GADS,ArpAlloc,Puts,Printf,StdAnchorPathPtr,FindFirst,
  21.                       FindNext,FreeAnchorChain,AnchorPathPtr,stdAnchorSize,
  22.                       ReadLine,ToUpper,Examine,ExNext,Lock,UnLock,DeleteFile;
  23. FROM Arts      IMPORT dosCmdBuf,dosCmdLen;
  24.  
  25. CONST Template='Files,D=DELETE/s,A=ASK/s,Q=QUIET/s';
  26.       Help='Usage: Scan <wildcards> [DELETE] [ASK] [QUIET]';
  27.       Help2='(Scanes or deletes files in dirs recursive.)';
  28.  
  29. TYPE String=ARRAY[0..107] OF CHAR;
  30.      StringPtr=POINTER TO String;
  31.      ArgType=RECORD
  32.       Files:StringPtr;
  33.       Delete,Ask,Quiet:ADDRESS;
  34.      END;
  35.  
  36. VAR  Flag:BOOLEAN;
  37.      Len,i:INTEGER;
  38.      lock:FileLockPtr;
  39.      Argc:INTEGER;
  40.      Slash:CHAR;
  41.      Arg:ArgType;
  42.      ap:StdAnchorPathPtr; 
  43.      Path,FileName,Read:String;
  44.                
  45. PROCEDURE Scan(VAR Dir:String);
  46. VAR  lock:FileLockPtr;
  47.      infoBlock:FileInfoBlockPtr;
  48.      Flag:BOOLEAN;
  49.      fName,NewDir:String;
  50.      Len:INTEGER;
  51.      
  52. BEGIN
  53.  infoBlock:=ArpAlloc(SIZE(FileInfoBlock));
  54.  NewDir:=Dir;
  55.  Len:=Length(NewDir);
  56.  IF (Len>0) AND (NewDir[Len-1]#':') THEN
  57.   Concat(NewDir,'/')
  58.  END;
  59.  Concat(NewDir,FileName);
  60.  IF FindFirst(ADR(NewDir),AnchorPathPtr(ADDRESS(ap)))=0 THEN
  61.   REPEAT
  62.    IF ap^.anchor.info.dirEntryType<1 THEN
  63.     IF Arg.Delete#NIL THEN
  64.      IF Arg.Ask#NIL THEN
  65.       Len:=Printf(ADR('Delete '),NIL);Len:=Printf(ADR(ap^.buffer),NIL);
  66.       Len:=Printf(ADR(' ? '),NIL);Len:=ReadLine(ADR(Read));
  67.       Read[0]:=ToUpper(Read[0])
  68.      ELSE
  69.       Read[0]:='Y'
  70.      END;
  71.      IF (Arg.Quiet=NIL) AND ((Read[0]='Y') OR (Read[0]='J')) THEN
  72.       Len:=Printf(ADR('Deleting '),NIL);Len:=Puts(ADR(ap^.buffer));
  73.       Flag:=DeleteFile(ADR(ap^.buffer));
  74.      END;
  75.      IF NOT Flag THEN
  76.       Len:=Puts(ADR('Not deleted - file is protected for deletion'))
  77.      END  
  78.     ELSE
  79.      Len:=Printf(ADR('Found '),NIL);Len:=Puts(ADR(ap^.buffer))
  80.     END
  81.    END
  82.   UNTIL FindNext(AnchorPathPtr(ADDRESS(ap)))#0
  83.  END;
  84.  lock:=Lock(ADR(Dir),accessRead);
  85.  Flag:=Examine(lock,infoBlock);
  86.  WHILE Flag DO
  87.   Flag:=ExNext(lock,infoBlock);
  88.   IF Flag THEN
  89.    fName:=CAST(String,infoBlock^.fileName);
  90.    IF (infoBlock^.dirEntryType >0) THEN 
  91.     NewDir:=Dir;
  92.     Len:=Length(NewDir);
  93.     IF (Len#0) AND (NewDir[Len-1]#':') THEN
  94.      Concat(NewDir,'/')
  95.     END;
  96.     Concat(NewDir,fName);
  97.     IF Arg.Quiet=NIL THEN
  98.      Len:=Printf(ADR(' Scanning '),NIL);Len:=Puts(ADR(NewDir))
  99.     END;
  100.     Scan(NewDir);
  101.    END;
  102.   END;
  103.  END;
  104.  UnLock(lock);
  105. END Scan;
  106.  
  107. PROCEDURE ExtractPath(VAR Path:String);
  108. VAR i,Len:INTEGER;
  109.     
  110. BEGIN
  111.  Len:=Length(Path);
  112.  IF Len=0 THEN 
  113.   RETURN 
  114.  END;
  115.  i:=Len-1;
  116.  LOOP
  117.   IF (Path[i]='/') THEN 
  118.    Path[i]:=0C;EXIT
  119.   ELSIF (Path[i]=':') THEN 
  120.    Path[i+1]:=0C;EXIT
  121.   ELSIF i=0 THEN 
  122.    Path[0]:=0C;EXIT
  123.   END;
  124.   DEC(i) 
  125.  END;
  126. END ExtractPath;
  127.      
  128. PROCEDURE ExtractFileName(VAR FileName:String);
  129. VAR i,j,Len:INTEGER;
  130.     Dummy:String;
  131.  
  132. BEGIN
  133.  Len:=Length(FileName);
  134.  IF Len=0 THEN 
  135.   RETURN 
  136.  END;
  137.  i:=Len-1;
  138.  LOOP
  139.   IF (FileName[i]=':') OR (FileName[i]='/') THEN
  140.    FOR j:=i+1 TO Len DO
  141.     Dummy[j-i-1]:=FileName[j];
  142.    END;
  143.    FileName:=Dummy;
  144.    EXIT
  145.   END;
  146.   IF i=0 THEN 
  147.    EXIT
  148.   ELSE
  149.    DEC(i)
  150.   END;
  151.  END;
  152. END ExtractFileName;
  153.  
  154. BEGIN
  155. Slash:='/';
  156. LOOP
  157.  Argc:=GADS(dosCmdBuf,dosCmdLen,ADR(Help),ADR(Arg),ADR(Template));
  158.  IF Argc<1 THEN
  159.   Len:=Puts(ADR(Help));
  160.   Len:=Puts(ADR(Help2));EXIT
  161.  END;
  162.  ap:=ArpAlloc(SIZE(ap^));
  163.  IF ap=NIL THEN
  164.   Len:=Puts(ADR('How about buying a 2 Meg memory-expansion?'));EXIT
  165.  END;
  166.  ap^.anchor.length:=stdAnchorSize;
  167.  ap^.anchor.breakBits:=LONGSET{ctrlC..ctrlF};
  168.  Path:=Arg.Files^;
  169.  FileName:=Arg.Files^;
  170.  ExtractPath(Path);
  171.  ExtractFileName(FileName);
  172.  lock:=Lock(ADR(Path),NIL);
  173.  IF lock=NIL THEN
  174.   Len:=Puts(ADR('Bad path'));EXIT
  175.  END;
  176.  IF (Arg.Quiet=NIL) AND (Length(FileName)=0) THEN
  177.   Len:=Puts(ADR('Bad filename'));EXIT
  178.  END;
  179.  Scan(Path);
  180.  FreeAnchorChain(AnchorPathPtr(ADDRESS(ap)));
  181.  EXIT;
  182. END
  183. END Scan.
  184.